home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / 35COM / Desktop.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-04-11  |  3.5 KB  |  128 lines
  1. unit Desktop;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  7.  
  8. type
  9.     TDesktop = class (TCustomControl)
  10.     private
  11.         { Private declarations }
  12.         fListView: hWnd;
  13.         fFont: TFont;
  14.         function GetItemCount: Integer;
  15.         procedure SetItemCount (Value: Integer);
  16.         procedure SetTextColor (Value: TColor);
  17.         function GetTextColor: TColor;
  18.         procedure SetTextBackgroundColor (Value: TColor);
  19.         function GetTextBackgroundColor: TColor;
  20.         procedure SetFont (Value: TFont);
  21.         function GetFont: TFont;
  22.     protected
  23.         { Protected declarations }
  24.         procedure Paint; override;
  25.     public
  26.         { Public declarations }
  27.         constructor Create (AOwner: TComponent); override;
  28.         destructor Destroy; override;
  29.     published
  30.         { Published declarations }
  31.         property Font: TFont read GetFont write SetFont;
  32.         property ItemCount: Integer read GetItemCount write SetItemCount;
  33.         property TextColor: TColor read GetTextColor write SetTextColor;
  34.         property TextBackgroundColor: TColor read GetTextBackgroundColor write SetTextBackgroundColor;
  35.     end;
  36.  
  37. procedure Register;
  38.  
  39. implementation
  40.  
  41. uses CommCtrl;
  42.  
  43. constructor TDesktop.Create (AOwner: TComponent);
  44. begin
  45.     Inherited Create (AOwner);
  46.     Width := GetSystemMetrics (sm_CxIcon);
  47.     Height := GetSystemMetrics (sm_CyIcon);
  48.     Visible := False;
  49.     fFont := TFont.Create;
  50.     // Start with the desktop window
  51.     fListView := GetDesktopWindow;
  52.     // Search through desktop children for the shell
  53.     fListView := FindWindowEx (fListView, 0, 'Progman', 'Program Manager');
  54.     // Search shell's children for the shell default view
  55.     fListView := FindWindowEx (fListView, 0, 'SHELLDLL_DefView', Nil);
  56.     // Finally, get the listview that's inside the shell default view
  57.     fListView := FindWindowEx (fListView, 0, 'SysListView32', Nil);
  58. end;
  59.  
  60. destructor TDesktop.Destroy;
  61. begin
  62.     fFont.Free;
  63.     Inherited;
  64. end;
  65.  
  66. procedure TDesktop.Paint;
  67. begin
  68.     if csDesigning in ComponentState then
  69.         DrawIcon (Canvas.Handle, 0, 0, LoadIcon (0, idi_WinLogo));
  70. end;
  71.  
  72. function TDesktop.GetFont: TFont;
  73. begin
  74.     Result := fFont;
  75. end;
  76.  
  77. procedure TDesktop.SetFont (Value: TFont);
  78. begin
  79.     fFont.Assign (Value);
  80.     SendMessage (fListView, wm_SetFont, fFont.Handle, Integer (True));
  81. end;
  82.  
  83. procedure TDesktop.SetTextColor (Value: TColor);
  84. begin
  85.     Value := ColorToRGB (Value);
  86.     if Value <> GetTextColor then begin
  87.         ListView_SetTextColor (fListView, Value);
  88.         InvalidateRect (fListView, Nil, True);
  89.     end;
  90. end;
  91.  
  92. function TDesktop.GetTextColor: TColor;
  93. begin
  94.     Result := ListView_GetTextColor (fListView);
  95. end;
  96.  
  97. procedure TDesktop.SetTextBackgroundColor (Value: TColor);
  98. begin
  99.     // If wanted color is clNone, interpret as Transparent
  100.     if Value = clNone then Value := $ffffffff else Value := ColorToRGB (Value);
  101.     if Value <> GetTextBackgroundColor then begin
  102.         ListView_SetTextBkColor (fListView, Value);
  103.         InvalidateRect (fListView, Nil, True);
  104.     end;
  105. end;
  106.  
  107. function TDesktop.GetTextBackgroundColor: TColor;
  108. begin
  109.     Result := ListView_GetTextBkColor (fListView);
  110. end;
  111.  
  112. function TDesktop.GetItemCount: Integer;
  113. begin
  114.     Result := ListView_GetItemCount (fListView);
  115. end;
  116.  
  117. procedure TDesktop.SetItemCount (Value: Integer);
  118. begin
  119.     // Read only property
  120. end;
  121.  
  122. procedure Register;
  123. begin
  124.     RegisterComponents ('Samples', [TDesktop]);
  125. end;
  126.  
  127. end.
  128.